home *** CD-ROM | disk | FTP | other *** search
/ Shareware Overload Trio 2 / Shareware Overload Trio Volume 2 (Chestnut CD-ROM).ISO / dir42 / jm0394.zip / TRAC1.SC < prev   
Text File  |  1993-12-29  |  14KB  |  392 lines
  1. ;************************************************************************
  2. ;  The following Library of procedures are:
  3. ;
  4. ;     Copyrighted (c) 1993 Micro-Phyla Systems  All Rights Reserved
  5. ;
  6. ;  Author: John B. Moore
  7. ;  CIS#: 71333,1775
  8. ;  This code is licensed to the holder to be used for their own personal
  9. ;  application development.  It cannot be used to produce a commercial
  10. ;  add-in that duplicates the function and purpose of these utilities.
  11. ;**************************************************************************
  12. ;*******************************************************************************
  13. ;                           TracTuner System Procs
  14. ;    Date: 9/6/93               Version 1
  15. ;*******************************************************************************
  16.  
  17. ; ============================================================
  18. ; 09-06-93
  19. ; Creates TracTuner windows
  20. ; ------------------------------------------------------------
  21. PROC TracTunerCreateWindows_u()
  22.    PRIVATE Procname.a,
  23.            attrib_bag,
  24.            h
  25.    Procname.a = "TracTunerCreateWindows_u"
  26.    ;- we need three windows: Triggers, Procs, Watch
  27.    ECHO OFF
  28.    ;--substitute your window handle dynarray if needed.
  29.    IF NOT ISASSIGNED(g_handle_bag) THEN
  30.         DYNARRAY g_handle_bag[]
  31.    ENDIF
  32.    h = SaveWindowHandle_n()
  33.     ; -- reset video
  34.     MENU {≡} {Video} {D: EGA/VGA: 80x43/50}
  35.    ;- setup basic attribs..
  36.    DYNARRAY attrib_bag[]
  37.       attrib_bag["CANCLOSE"] = FALSE
  38.       attrib_bag["CANMAXIMIZE"] = FALSE
  39.       attrib_bag["CANRESIZE"] = FALSE
  40.       attrib_bag["CANMOVE"] = FALSE
  41.       attrib_bag["FLOATING"] = TRUE
  42.       attrib_bag["HASSHADOW"] = FALSE
  43.       attrib_bag["HASFRAME"] = FALSE
  44.       attrib_bag["MAXIMIZED"] = FALSE
  45.       attrib_bag["CANVASHEIGHT"] = 200
  46.  
  47.    ;- Triggers window
  48.       attrib_bag["TITLE"] = "Triggers"
  49.       attrib_bag["ORIGINCOL"] = 0
  50.       attrib_bag["ORIGINROW"] = 24
  51.       attrib_bag["WIDTH"] = 40
  52.       attrib_bag["HEIGHT"] = 12
  53.       attrib_bag["STYLE"] = 31  ;white on blue
  54.       WINDOW CREATE ATTRIBUTES attrib_bag TO g_handle_bag["TRIGGERS"]
  55.       PAINTCANVAS ATTRIBUTE 31 ALL
  56.  
  57.  
  58.     ;- define dynarrays..
  59.     DYNARRAY  tr_trigger_bag[]
  60.  
  61.     WINDOW SELECT h
  62.     WINDOW SELECT h
  63.     ECHO NORMAL
  64.  
  65. ENDPROC
  66. ;("TracTunerCreateWindows_u")
  67.  
  68. ; ============================================================
  69. ; 09-06-93
  70. ;
  71. ; ------------------------------------------------------------
  72. PROC TracTunerDestroyWindows_u()
  73.    PRIVATE Procname.a,
  74.            h
  75.    Procname.a = "TracTunerDestroyWindows_u"
  76.    IF ISASSIGNED(g_handle_bag["TRIGGERS"]) AND
  77.       ISWINDOW(g_handle_bag["TRIGGERS"]) THEN
  78.       ECHO OFF
  79.       h = SaveWindowHandle_n()
  80.       ;- close windows
  81.       WINDOW SELECT g_handle_bag["TRIGGERS"]
  82.       WINDOW SELECT g_handle_bag["TRIGGERS"]
  83.       WINDOW CLOSE
  84.       ;- release vars related to  TracTuner
  85.       RELEASE VARS  g_handle_bag["TRIGGERS"],
  86.                   tr_trigger_bag,
  87.                   g_cycle_n
  88.  
  89.       ; -- reset video
  90.       MENU {≡} {Video} {C: EGA/VGA: 80x25}
  91.       WINDOW SELECT h
  92.       WINDOW SELECT h
  93.       ;- upon shifting back to 80x25 a former max window will only
  94.       ;  take up half the screen
  95.       WINMAX
  96.   ENDIF
  97. ENDPROC
  98. ;("TracTunerDestroyWindows_u")
  99.  
  100.  
  101. ; ============================================================
  102. ; 09-06-93
  103. ; Main TracTuner proc
  104. ; ------------------------------------------------------------
  105. PROC TracTuner_u(cycle_n,proc_a,trigger_a,type_a,rval_n)
  106.    PRIVATE Procname.a,
  107.            current_h
  108.    Procname.a = "TracTuner_u"
  109.    IF ISASSIGNED(TracTuner_l) AND TracTuner_l THEN
  110.       IF NOT ISASSIGNED(g_cycle_n) THEN
  111.          g_cycle_n = 0
  112.       ENDIF
  113.       ECHO OFF
  114.       current_h = SaveWindowHandle_n()
  115.       IF cycle_n <> g_cycle_n OR
  116.          NOT ISASSIGNED(tr_trigger_bag) THEN
  117.          ;--define or reset arrays
  118.          DYNARRAY  tr_trigger_bag[]
  119.       ENDIF
  120.  
  121.       TracTunerRefreshWindows_u(cycle_n,proc_a,trigger_a,type_a,rval_n)
  122.  
  123.       SETCANVAS DEFAULT
  124.       STYLE
  125.       WINDOW SELECT current_h
  126.       WINDOW SELECT current_h
  127.       ;--update cycle
  128.       g_cycle_n = cycle_n
  129.    ENDIF
  130. ENDPROC
  131. ;("TracTuner_u")
  132.  
  133. ; ============================================================
  134. ; 09-06-93
  135. ; Sets up or removes TracTuner
  136. ; ------------------------------------------------------------
  137. PROC TracTunerSetup_n()
  138.    PRIVATE Procname.a
  139.    Procname.a = "TracTunerSetup_n"
  140.    ECHO OFF
  141.    IF ISASSIGNED(TracTuner_l) THEN
  142.       ;--If you have mouse button canvas windows or something
  143.       ;  similar you would move those off screen at this point
  144.       ;  Example:
  145.       ;     WaitMouseButtonPutaway_u(currentpage_n)
  146.       TracTunerDestroyWindows_u()
  147.       IF ISFILE("watch.sc") THEN
  148.          RUN NOREFRESH "DEL watch.sc >>nul"
  149.       ENDIF
  150.       ;--Now you would move any floating windows back on screen
  151.       ;  so they will be located in the proper position.
  152.       ;  Examples:
  153.       ;   WINDOW MOVE g_handle_bag["SPEEDBAR"] TO 23,0
  154.       ;   WaitMouseButtonsPlace_u(currentpage_n)
  155.       RELEASE VARS TracTuner_l
  156.    ELSE
  157.      TracTuner_l = true
  158.       ;--If you have mouse button canvas windows or something
  159.       ;  similar you would move those off screen at this point
  160.       ;  Example:
  161.       ;     WaitMouseButtonPutaway_u(currentpage_n)
  162.       IF ISFILE("watch.sc") THEN
  163.          RUN NOREFRESH "DEL watch.sc >>nul"
  164.       ENDIF
  165.      TracTunerCreateWindows_u()
  166.       ;--Now you would move any floating windows back on screen
  167.       ;  so they will be located in the proper position.
  168.       ;  Examples:
  169.       ;   WINDOW MOVE g_handle_bag["SPEEDBAR"] TO 23,0
  170.       ;   WaitMouseButtonsPlace_u(currentpage_n)
  171.    ENDIF
  172.    ECHO NORMAL
  173.    RETURN 1
  174. ENDPROC
  175. ;("TracTunerSetup_n")
  176.  
  177.  
  178.  
  179. ; ============================================================
  180. ; 09-07-93
  181. ; Writes to windows if info is present
  182. ; ------------------------------------------------------------
  183. PROC TracTunerRefreshWindows_u(cycle_n,proc_a,trigger_a,type_a,rval_n)
  184.             ;type_a: "D" = default "C" = coherced
  185.             ;proc_a: ""= no proc executed
  186.             ;rval_n: current retval
  187.    PRIVATE Procname.a,
  188.            el,
  189.            n,
  190.            count_n,
  191.            basetrigger_a,
  192.            abrtrigger_a,
  193.            h
  194.    Procname.a = "TracTunerRefreshWindows_u"
  195.    h = SaveWindowHandle_n()
  196.    ;--triggers
  197.    basetrigger_a =  trigger_a
  198.    abrtrigger_a = TracTunerAbrTrigger_a(trigger_a)
  199.    SETCANVAS g_handle_bag["TRIGGERS"]
  200.    STYLE ATTRIBUTE 31
  201.    IF g_cycle_n <> cycle_n THEN
  202.       CLEAR
  203.       PAINTCANVAS ATTRIBUTE 31 ALL
  204.       WINDOW SELECT g_handle_bag["TRIGGERS"]
  205.       WINDOW SCROLL g_handle_bag["TRIGGERS"] TO 0,0
  206.       SETMARGIN OFF
  207.       STYLE ATTRIBUTE 14
  208.       @0,0 ?? FORMAT("W40,AC","* * TRIGGERS * *")
  209.       @2,0
  210.       STYLE ATTRIBUTE 31
  211.    ENDIF
  212.    SETMARGIN 3
  213.    count_n = DYNARRAYSIZE(tr_trigger_bag)
  214.    IF type_a = "C" THEN
  215.       trigger_a = LOWER(trigger_a)
  216.    ENDIF
  217.    IF NOT ISBLANK(proc_a) THEN
  218.       trigger_a =  CHR(251)+trigger_a
  219.    ELSE
  220.       trigger_a = " "+trigger_a
  221.    ENDIF
  222.    ;- place on screen
  223.    ? STRVAL(count_n+1)+"-"+trigger_a
  224.    ;--update cycle history
  225.    tr_trigger_bag[count_n+1] = trigger_a
  226.  
  227.    WINDOW SELECT h
  228.    WINDOW SELECT h
  229. ENDPROC
  230. ;("TracTunerRefreshWindows_u")
  231.  
  232.  
  233.  
  234.  
  235.  
  236. ; ============================================================
  237. ; 09-07-93
  238. ; returns abreviation of trigger
  239. ; ------------------------------------------------------------
  240. PROC TracTunerAbrTrigger_a(eventype_a)
  241.    PRIVATE Procname.a
  242.    Procname.a = "TracTunerAbrTrigger_a"
  243.       SWITCH
  244.          CASE eventype_a = "VALCHECK"    :RETURN "VC-"
  245.          CASE eventype_a = "DEPARTFIELD" :RETURN "DF-"
  246.          CASE eventype_a = "DEPARTROW"   :RETURN "DR-"
  247.          CASE eventype_a = "POSTRECORD"  :RETURN "PR-"
  248.          CASE eventype_a = "DEPARTABLE"  :RETURN "DT-"
  249.          CASE eventype_a = "DEPARTPAGE"  :RETURN "DP-"
  250.          CASE eventype_a = "ARRIVEPAGE"  :RETURN "AP-"
  251.          CASE eventype_a = "ARRIVEWINDOW":RETURN "AW-"
  252.          CASE eventype_a = "ARRIVETABLE" :RETURN "AT-"
  253.          CASE eventype_a = "ARRIVEROW"   :RETURN "AR-"
  254.          CASE eventype_a = "ARRIVEFIELD" :RETURN "AF-"
  255.          OTHERWISE : RETURN "NA-"
  256.       ENDSWITCH
  257. ENDPROC
  258. ;("TracTunerAbrTrigger_a")
  259.  
  260. ;==============================================================
  261. ; Last compiled:  9/07/93
  262. ;
  263. ;--------------------------------------------------------------
  264. PROC TRACMenudef_n()
  265.    PRIVATE Procname_a
  266.    Procname_a = "TRACMenudef_n"
  267.    SHOWPOPUP " TracTuner System "  CENTERED
  268.       "~S~tart TracTuner":"Start TracTuner System":"start",
  269.       "~C~lose TracTuner":"Close TracTuner System":"close",
  270.       "~Q~uit TracTuner Menu":"Close TracTuner menu":"quit"
  271.    ENDMENU TO choice_a
  272.       SWITCH
  273.          CASE choice_a = "quit" :
  274.             RETURN 1
  275.          CASE choice_a = "close" :
  276.             TracTunerSetup_n()
  277.          CASE choice_a = "start" :
  278.             TracTunerSetup_n()
  279.       ENDSWITCH
  280.     RETURN 1
  281. ENDPROC
  282. ;("TRACMenudef_n")
  283.  
  284. ;;;======================================================================
  285. ;;; Following are some supporting procedures that are either being used in
  286. ;;; this system OR are mention in the articles as examples.
  287. ;;;======================================================================
  288. ;;
  289. ;;; ============================================================
  290. ;;; 08-22-93
  291. ;;; checks requested depart triggers
  292. ;;; ------------------------------------------------------------
  293. ;;PROC BeforeTriggers_l(triggers_a) ;format "VC,DF,DR,PR,DR,DT,EXIT"
  294. ;;   PRIVATE Procname.a,
  295. ;;           ok_n,
  296. ;;           eventype_a,
  297. ;;           eventcode_a
  298. ;;   Procname.a = "BeforeTriggers_l"
  299. ;;   WHILE MATCH(triggers_a,"..,..",eventcode_a,triggers_a)
  300. ;;      SWITCH
  301. ;;         CASE eventcode_a = "VC": eventype_a = "VALCHECK"
  302. ;;         CASE eventcode_a = "DF": eventype_a = "DEPARTFIELD"
  303. ;;         CASE eventcode_a = "DR": eventype_a = "DEPARTROW"
  304. ;;         CASE eventcode_a = "PR": eventype_a = "POSTRECORD"
  305. ;;         CASE eventcode_a = "DT": eventype_a = "DEPARTABLE"
  306. ;;         CASE eventcode_a = "DP": eventype_a = "DEPARTPAGE"
  307. ;;      ENDSWITCH
  308. ;;      IF IsAssigned(g_action_bag[TABLE()+eventype_a]) OR
  309. ;;         IsAssigned(g_action_bag[TABLE()+FIELD()+eventype_a]) THEN
  310. ;;               ok_n = WaitTriggerDispatcher_n(TABLE(),FIELD(),eventype_a)
  311. ;;               IF ISASSIGNED(tractuner_l) THEN
  312. ;;                  SWITCH
  313. ;;                     CASE ISASSIGNED(g_action_bag[TABLE()+FIELD()+eventype_a]):
  314. ;;                           proc_a = g_action_bag[TABLE()+FIELD()+eventype_a]
  315. ;;                     CASE ISASSIGNED(g_action_bag[TABLE()+eventype_a]) :
  316. ;;                           proc_a = g_action_bag[TABLE()+eventype_a]
  317. ;;                     OTHERWISE: proc_a = ""
  318. ;;                  ENDSWITCH
  319. ;;                  tractuner_u(cyclenumber_n,proc_a,eventype_a,
  320. ;;                           "C",ok_n)
  321. ;;               ENDIF
  322. ;;               IF ok_n = 1 THEN RETURN false ENDIF
  323. ;;      ENDIF
  324. ;;      ;--standard default events
  325. ;;      SWITCH
  326. ;;         ;---general generic procs---------depart events
  327. ;;         CASE eventype_a = "POSTRECORD":
  328. ;;            ok_n = WaitPostRecord_n()
  329. ;;            tractuner_u(cyclenumber_n,"WaitPostRecord_n",eventype_a,
  330. ;;                     "C",ok_n)
  331. ;;            IF ok_n = 1 THEN RETURN false ENDIF
  332. ;;         CASE eventype_a = "IMAGERIGHTS": RETURN false
  333. ;;         CASE eventype_a = "PASSRIGHTS":  RETURN false
  334. ;;         CASE eventype_a = "VALCHECK":
  335. ;;            IF NOT ISVALID() THEN
  336. ;;               BEEP BEEP
  337. ;;               IMAGERIGHTS  CTRLBACKSPACE
  338. ;;               GeneralMessage_u("The field you are attempting to leave      /"+
  339. ;;                              "does not have a valid value for that field./"+
  340. ;;                              "It will be cleared for you and you need to /"+
  341. ;;                              "then insert a valid value.                 /"+
  342. ;;                              " <Enter> - continues../")
  343. ;;               tractuner_u(cyclenumber_n,"",eventype_a,
  344. ;;                        "C",1)
  345. ;;               RETURN false
  346. ;;            ENDIF
  347. ;;            RETURN true
  348. ;;         CASE eventype_a = "DISPLAYONLY": RETURN false
  349. ;;         CASE eventype_a = "READONLY":    RETURN false
  350. ;;         CASE eventype_a = "REQUIREDVALUE":  RETURN false
  351. ;;      ENDSWITCH
  352. ;;      IF triggers_a = "EXIT" THEN QUITLOOP ENDIF
  353. ;;   ENDWHILE
  354. ;;   ;--if you get here everything passed..
  355. ;;   RETURN true
  356. ;;ENDPROC
  357. ;;;("BeforeTriggers_l")
  358. ;;
  359. ;;
  360. ;;; ============================================================
  361. ;;; 11-10-92
  362. ;;; Saves the current window handle and returns that value
  363. ;;; ------------------------------------------------------------
  364. ;;PROC SaveWindowHandle_n()
  365. ;;   PRIVATE Procname_a,
  366. ;;           ihandle_h,
  367. ;;           fhandle_h,
  368. ;;           dhandle_h,
  369. ;;           chandle_h
  370. ;;   Procname_a = "SaveWindowHandle_n"
  371. ;;   WINDOW HANDLE IMAGE IMAGENO() TO ihandle_h
  372. ;;   WINDOW HANDLE FORM TO fhandle_h
  373. ;;   WINDOW HANDLE DIALOG TO dhandle_h
  374. ;;   WINDOW HANDLE CURRENT TO chandle_h
  375. ;;   ;-- the following logic is that if a dialog handle is there it is
  376. ;;   ;   the one we want returned, next is a form handle, then an image
  377. ;;   ;   handle, and lastly the current window
  378. ;;   SWITCH
  379. ;;      CASE dhandle_h <> 0 : RETURN dhandle_h
  380. ;;      CASE fhandle_h <> 0 : RETURN fhandle_h
  381. ;;      CASE ihandle_h <> 0 : RETURN ihandle_h
  382. ;;      CASE chandle_h <> 0 : RETURN chandle_h
  383. ;;      OTHERWISE:
  384. ;;         GeneralMessage_u("ERROR, Expecting a window handle assignment/"+
  385. ;;                          "no windows present.  Exit module and report/"+
  386. ;;                          "error message..   Anykey continues..      /")
  387. ;;         RETURN 0
  388. ;;   ENDSWITCH
  389. ;;ENDPROC
  390. ;;;("SaveWindowHandle_n")
  391. ;;
  392.